#' Occurrence Counts by Grade

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Functions for analyzing frequencies and fractions of occurrences by grade for patients

#' with occurrence data. Multiple occurrences within one individual are counted once at the

#' greatest intensity/highest grade level.

#'

#' @inheritParams argument_convention

#' @param grade_groups (named `list` of `character`)\cr containing groupings of grades.

#' @param remove_single (`logical`)\cr `TRUE` to not include the elements of one-element grade groups

#'   in the the output list; in this case only the grade groups names will be included in the output. If

#'   `only_grade_groups` is set to `TRUE` this argument is ignored.

#' @param only_grade_groups (`flag`)\cr whether only the specified grade groups should be

#'   included, with individual grade rows removed (`TRUE`), or all grades and grade groups

#'   should be displayed (`FALSE`).

#' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("count_occurrences_by_grade")`

#'   to see available statistics for this function.

#'

#' @seealso Relevant helper function [h_append_grade_groups()].

#'

#' @name count_occurrences_by_grade

#' @order 1

NULL

#' Helper function for [s_count_occurrences_by_grade()]

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Helper function for [s_count_occurrences_by_grade()] to insert grade groupings into list with

#' individual grade frequencies. The order of the final result follows the order of `grade_groups`.

#' The elements under any-grade group (if any), i.e. the grade group equal to `refs` will be moved to

#' the end. Grade groups names must be unique.

#'

#' @inheritParams count_occurrences_by_grade

#' @param refs (named `list` of `numeric`)\cr where each name corresponds to a reference grade level

#'   and each entry represents a count.

#'

#' @return Formatted list of grade groupings.

#'

#' @examples

#' h_append_grade_groups(

#'   list(

#'     "Any Grade" = as.character(1:5),

#'     "Grade 1-2" = c("1", "2"),

#'     "Grade 3-4" = c("3", "4")

#'   ),

#'   list("1" = 10, "2" = 20, "3" = 30, "4" = 40, "5" = 50)

#' )

#'

#' h_append_grade_groups(

#'   list(

#'     "Any Grade" = as.character(5:1),

#'     "Grade A" = "5",

#'     "Grade B" = c("4", "3")

#'   ),

#'   list("1" = 10, "2" = 20, "3" = 30, "4" = 40, "5" = 50)

#' )

#'

#' h_append_grade_groups(

#'   list(

#'     "Any Grade" = as.character(1:5),

#'     "Grade 1-2" = c("1", "2"),

#'     "Grade 3-4" = c("3", "4")

#'   ),

#'   list("1" = 10, "2" = 5, "3" = 0)

#' )

#'

#' @export

h_append_grade_groups <- function(grade_groups, refs, remove_single = TRUE, only_grade_groups = FALSE) {

  ### compute sums in groups

  }

  ### order result while keeping grade_groups's ordering

  # elements of any-grade group (if any) will be moved to the end

  # groups-elements combined sequence

  # append remaining elements (if any)

  # remove elements of single-element groups, if any

  }

  # apply the order

  # remove groups without any elements in the original refs

  # note: it's OK if groups have 0 value

}

#' @describeIn count_occurrences_by_grade Statistics function which counts the

#'  number of patients by highest grade.

#'

#' @return

#' * `s_count_occurrences_by_grade()` returns a list of counts and fractions with one element per grade level or

#'   grade level grouping.

#'

#' @examples

#' s_count_occurrences_by_grade(

#'   df,

#'   .N_col = 10L,

#'   .var = "AETOXGR",

#'   id = "USUBJID",

#'   grade_groups = list("ANY" = levels(df$AETOXGR))

#' )

#'

#' @export

s_count_occurrences_by_grade <- function(df,

                                         .var,

                                         .N_col, # nolint

                                         id = "USUBJID",

                                         grade_groups = list(),

                                         remove_single = TRUE,

                                         only_grade_groups = FALSE,

                                         labelstr = "") {

  } else {

    } else {

    }

      } else {

      }

    }

      )

    }

  }

  }

  )

}

#' @describeIn count_occurrences_by_grade Formatted analysis function which is used as `afun`

#'   in `count_occurrences_by_grade()`.

#'

#' @return

#' * `a_count_occurrences_by_grade()` returns the corresponding list with formatted [rtables::CellValue()].

#'

#' @examples

#' #  We need to ungroup `count_fraction` first so that the `rtables` formatting

#' # function `format_count_fraction()` can be applied correctly.

#' afun <- make_afun(a_count_occurrences_by_grade, .ungroup_stats = "count_fraction")

#' afun(

#'   df,

#'   .N_col = 10L,

#'   .var = "AETOXGR",

#'   id = "USUBJID",

#'   grade_groups = list("ANY" = levels(df$AETOXGR))

#' )

#'

#' @export

a_count_occurrences_by_grade <- make_afun(

  s_count_occurrences_by_grade,

  .formats = c("count_fraction" = format_count_fraction_fixed_dp)

)

#' @describeIn count_occurrences_by_grade Layout-creating function which can take statistics function

#'   arguments and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @return

#' * `count_occurrences_by_grade()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing

#'   the statistics from `s_count_occurrences_by_grade()` to the table layout.

#'

#' @examples

#' library(dplyr)

#'

#' df <- data.frame(

#'   USUBJID = as.character(c(1:6, 1)),

#'   ARM = factor(c("A", "A", "A", "B", "B", "B", "A"), levels = c("A", "B")),

#'   AETOXGR = factor(c(1, 2, 3, 4, 1, 2, 3), levels = c(1:5)),

#'   AESEV = factor(

#'     x = c("MILD", "MODERATE", "SEVERE", "MILD", "MILD", "MODERATE", "SEVERE"),

#'     levels = c("MILD", "MODERATE", "SEVERE")

#'   ),

#'   stringsAsFactors = FALSE

#' )

#'

#' df_adsl <- df %>%

#'   select(USUBJID, ARM) %>%

#'   unique()

#'

#' # Layout creating function with custom format.

#' basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   count_occurrences_by_grade(

#'     var = "AESEV",

#'     .formats = c("count_fraction" = "xx.xx (xx.xx%)")

#'   ) %>%

#'   build_table(df, alt_counts_df = df_adsl)

#'

#' # Define additional grade groupings.

#' grade_groups <- list(

#'   "-Any-" = c("1", "2", "3", "4", "5"),

#'   "Grade 1-2" = c("1", "2"),

#'   "Grade 3-5" = c("3", "4", "5")

#' )

#'

#' basic_table() %>%

#'   split_cols_by("ARM") %>%

#'   add_colcounts() %>%

#'   count_occurrences_by_grade(

#'     var = "AETOXGR",

#'     grade_groups = grade_groups,

#'     only_grade_groups = TRUE

#'   ) %>%

#'   build_table(df, alt_counts_df = df_adsl)

#'

#' @export

#' @order 2

count_occurrences_by_grade <- function(lyt,

                                       var,

                                       id = "USUBJID",

                                       grade_groups = list(),

                                       remove_single = TRUE,

                                       only_grade_groups = FALSE,

                                       var_labels = var,

                                       show_labels = "default",

                                       riskdiff = FALSE,

                                       na_str = default_na_str(),

                                       nested = TRUE,

                                       ...,

                                       table_names = var,

                                       .stats = NULL,

                                       .formats = NULL,

                                       .indent_mods = NULL,

                                       .labels = NULL) {

  )

  )

  } else {

    )

  }

  )

}

#' @describeIn count_occurrences_by_grade Layout-creating function which can take content function arguments

#'   and additional format arguments. This function is a wrapper for [rtables::summarize_row_groups()].

#'

#' @return

#' * `summarize_occurrences_by_grade()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted content rows

#'   containing the statistics from `s_count_occurrences_by_grade()` to the table layout.

#'

#' @examples

#' # Layout creating function with custom format.

#' basic_table() %>%

#'   add_colcounts() %>%

#'   split_rows_by("ARM", child_labels = "visible", nested = TRUE) %>%

#'   summarize_occurrences_by_grade(

#'     var = "AESEV",

#'     .formats = c("count_fraction" = "xx.xx (xx.xx%)")

#'   ) %>%

#'   build_table(df, alt_counts_df = df_adsl)

#'

#' basic_table() %>%

#'   add_colcounts() %>%

#'   split_rows_by("ARM", child_labels = "visible", nested = TRUE) %>%

#'   summarize_occurrences_by_grade(

#'     var = "AETOXGR",

#'     grade_groups = grade_groups

#'   ) %>%

#'   build_table(df, alt_counts_df = df_adsl)

#'

#' @export

#' @order 3

summarize_occurrences_by_grade <- function(lyt,

                                           var,

                                           id = "USUBJID",

                                           grade_groups = list(),

                                           remove_single = TRUE,

                                           only_grade_groups = FALSE,

                                           na_str = default_na_str(),

                                           ...,

                                           .stats = NULL,

                                           .formats = NULL,

                                           .indent_mods = NULL,

                                           .labels = NULL) {

  )

  )

  )

}

#' Odds Ratio Estimation

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Compares bivariate responses between two groups in terms of odds ratios

#' along with a confidence interval.

#'

#' @inheritParams split_cols_by_groups

#' @inheritParams argument_convention

#' @param .stats (`character`)\cr statistics to select for the table. Run `get_stats("estimate_odds_ratio")`

#'   to see available statistics for this function.

#'

#' @details This function uses either logistic regression for unstratified

#'   analyses, or conditional logistic regression for stratified analyses.

#'   The Wald confidence interval with the specified confidence level is

#'   calculated.

#'

#' @note For stratified analyses, there is currently no implementation for conditional

#'   likelihood confidence intervals, therefore the likelihood confidence interval is not

#'   yet available as an option. Besides, when `rsp` contains only responders or non-responders,

#'   then the result values will be `NA`, because no odds ratio estimation is possible.

#'

#' @seealso Relevant helper function [h_odds_ratio()].

#'

#' @name odds_ratio

#' @order 1

NULL

#' @describeIn odds_ratio Statistics function which estimates the odds ratio

#'   between a treatment and a control. A `variables` list with `arm` and `strata`

#'   variable names must be passed if a stratified analysis is required.

#'

#' @return

#' * `s_odds_ratio()` returns a named list with the statistics `or_ci`

#'   (containing `est`, `lcl`, and `ucl`) and `n_tot`.

#'

#' @examples

#' # Unstratified analysis.

#' s_odds_ratio(

#'   df = subset(dta, grp == "A"),

#'   .var = "rsp",

#'   .ref_group = subset(dta, grp == "B"),

#'   .in_ref_col = FALSE,

#'   .df_row = dta

#' )

#'

#' # Stratified analysis.

#' s_odds_ratio(

#'   df = subset(dta, grp == "A"),

#'   .var = "rsp",

#'   .ref_group = subset(dta, grp == "B"),

#'   .in_ref_col = FALSE,

#'   .df_row = dta,

#'   variables = list(arm = "grp", strata = "strata")

#' )

#'

#' @export

s_odds_ratio <- function(df,

                         .var,

                         .ref_group,

                         .in_ref_col,

                         .df_row,

                         variables = list(arm = NULL, strata = NULL),

                         conf_level = 0.95,

                         groups_list = NULL) {

        )

      )

    } else {

      # The group variable prepared for clogit must be synchronised with combination groups definition.

      } else {

        # If more than one level in reference col.

        )

        # If more than one level in treatment col.

        )

      }

      # The reference level in `grp` must be the same as in the `rtables` column split.

      )

    }

  }

  )

  )

}

#' @describeIn odds_ratio Formatted analysis function which is used as `afun` in `estimate_odds_ratio()`.

#'

#' @return

#' * `a_odds_ratio()` returns the corresponding list with formatted [rtables::CellValue()].

#'

#' @examples

#' a_odds_ratio(

#'   df = subset(dta, grp == "A"),

#'   .var = "rsp",

#'   .ref_group = subset(dta, grp == "B"),

#'   .in_ref_col = FALSE,

#'   .df_row = dta

#' )

#'

#' @export

a_odds_ratio <- make_afun(

  s_odds_ratio,

  .formats = c(or_ci = "xx.xx (xx.xx - xx.xx)"),

  .indent_mods = c(or_ci = 1L)

)

#' @describeIn odds_ratio Layout-creating function which can take statistics function arguments

#'   and additional format arguments. This function is a wrapper for [rtables::analyze()].

#'

#' @param ... arguments passed to `s_odds_ratio()`.

#'

#' @return

#' * `estimate_odds_ratio()` returns a layout object suitable for passing to further layouting functions,

#'   or to [rtables::build_table()]. Adding this function to an `rtable` layout will add formatted rows containing

#'   the statistics from `s_odds_ratio()` to the table layout.

#'

#' @examples

#' set.seed(12)

#' dta <- data.frame(

#'   rsp = sample(c(TRUE, FALSE), 100, TRUE),

#'   grp = factor(rep(c("A", "B"), each = 50), levels = c("A", "B")),

#'   strata = factor(sample(c("C", "D"), 100, TRUE))

#' )

#'

#' l <- basic_table() %>%

#'   split_cols_by(var = "grp", ref_group = "B") %>%

#'   estimate_odds_ratio(vars = "rsp")

#'

#' build_table(l, df = dta)

#'

#' @export

#' @order 2

estimate_odds_ratio <- function(lyt,

                                vars,

                                variables = list(arm = NULL, strata = NULL),

                                conf_level = 0.95,

                                groups_list = NULL,

                                na_str = default_na_str(),

                                nested = TRUE,

                                ...,

                                show_labels = "hidden",

                                table_names = vars,

                                .stats = "or_ci",

                                .formats = NULL,

                                .labels = NULL,

                                .indent_mods = NULL) {

  )

  )

}

#' Helper Functions for Odds Ratio Estimation

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Functions to calculate odds ratios in [estimate_odds_ratio()].

#'

#' @inheritParams argument_convention

#' @param data (`data.frame`)\cr data frame containing at least the variables `rsp` and `grp`, and optionally

#'   `strata` for [or_clogit()].

#'

#' @return A named `list` of elements `or_ci` and `n_tot`.

#'

#' @seealso [odds_ratio]

#'

#' @name h_odds_ratio

NULL

#' @describeIn h_odds_ratio Estimates the odds ratio based on [stats::glm()]. Note that there must be

#'   exactly 2 groups in `data` as specified by the `grp` variable.

#'

#' @examples

#' # Data with 2 groups.

#' data <- data.frame(

#'   rsp = as.logical(c(1, 1, 0, 1, 0, 0, 1, 1)),

#'   grp = letters[c(1, 1, 1, 2, 2, 2, 1, 2)],

#'   strata = letters[c(1, 2, 1, 2, 2, 2, 1, 2)],

#'   stringsAsFactors = TRUE

#' )

#'

#' # Odds ratio based on glm.

#' or_glm(data, conf_level = 0.95)

#'

#' @export

or_glm <- function(data, conf_level) {

  )

  # Note that here we need to discard the intercept.

  )

}

#' @describeIn h_odds_ratio estimates the odds ratio based on [survival::clogit()]. This is done for

#'   the whole data set including all groups, since the results are not the same as when doing

#'   pairwise comparisons between the groups.

#'

#' @examples

#' # Data with 3 groups.

#' data <- data.frame(

#'   rsp = as.logical(c(1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0)),

#'   grp = letters[c(1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 1, 1, 1, 2, 2, 2, 3, 3, 3, 3)],

#'   strata = LETTERS[c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)],

#'   stringsAsFactors = TRUE

#' )

#'

#' # Odds ratio based on stratified estimation by conditional logistic regression.

#' or_clogit(data, conf_level = 0.95)

#'

#' @export

or_clogit <- function(data, conf_level) {

  # Deviation from convention: `survival::strata` must be simply `strata`.

  # Create a list with one set of OR estimates and CI per coefficient, i.e.

  # comparison of one group vs. the reference group.

    )

  }

}

#' Univariate Formula Special Term

#'

#' @description `r lifecycle::badge("stable")`

#'

#' The special term `univariate` indicate that the model should be fitted individually for

#' every variable included in univariate.

#'

#' @param x A vector of variable name separated by commas.

#'

#' @return When used within a model formula, produces univariate models for each variable provided.

#'

#' @details

#' If provided alongside with pairwise specification, the model

#' `y ~ ARM + univariate(SEX, AGE, RACE)` lead to the study and comparison of the models

#' + `y ~ ARM`

#' + `y ~ ARM + SEX`

#' + `y ~ ARM + AGE`

#' + `y ~ ARM + RACE`

#'

#' @export

univariate <- function(x) {

}

# Get the right-hand-term of a formula

rht <- function(x) {

}

#' Hazard Ratio Estimation in Interactions

#'

#' This function estimates the hazard ratios between arms when an interaction variable is given with

#' specific values.

#'

#' @param variable,given Names of two variable in interaction. We seek the estimation of the levels of `variable`

#'   given the levels of `given`.

#' @param lvl_var,lvl_given corresponding levels has given by `levels`.

#' @param mmat A name numeric filled with 0 used as template to obtain the design matrix.

#' @param coef Numeric of estimated coefficients.

#' @param vcov Variance-covariance matrix of underlying model.

#' @param conf_level Single numeric for the confidence level of estimate intervals.

#'

#' @details Given the cox regression investigating the effect of Arm (A, B, C; reference A)

#'   and Sex (F, M; reference Female). The model is abbreviated: y ~ Arm + Sex + Arm x Sex.

#'   The cox regression estimates the coefficients along with a variance-covariance matrix for:

#'

#'   - b1 (arm b), b2 (arm c)

#'   - b3 (sex m)

#'   - b4 (arm b: sex m), b5 (arm c: sex m)

#'

#'   Given that I want an estimation of the Hazard Ratio for arm C/sex M, the estimation

#'   will be given in reference to arm A/Sex M by exp(b2 + b3 + b5)/ exp(b3) = exp(b2 + b5),

#'   therefore the interaction coefficient is given by b2 + b5 while the standard error is obtained

#'   as $1.96 * sqrt(Var b2 + Var b5 + 2 * covariance (b2,b5))$ for a confidence level of 0.95.

#'

#' @return A list of matrix (one per level of variable) with rows corresponding to the combinations of

#'   `variable` and `given`, with columns:

#'   * `coef_hat`: Estimation of the coefficient.

#'   * `coef_se`: Standard error of the estimation.

#'   * `hr`: Hazard ratio.

#'   * `lcl, ucl`: Lower/upper confidence limit of the hazard ratio.

#'

#' @seealso [s_cox_multivariate()].

#'

#' @examples

#' library(dplyr)

#' library(survival)

#'

#' ADSL <- tern_ex_adsl %>%

#'   filter(SEX %in% c("F", "M"))

#'

#' adtte <- tern_ex_adtte %>% filter(PARAMCD == "PFS")

#' adtte$ARMCD <- droplevels(adtte$ARMCD)

#' adtte$SEX <- droplevels(adtte$SEX)

#'

#' mod <- coxph(

#'   formula = Surv(time = AVAL, event = 1 - CNSR) ~ (SEX + ARMCD)^2,

#'   data = adtte

#' )

#'

#' mmat <- stats::model.matrix(mod)[1, ]

#' mmat[!mmat == 0] <- 0

#'

#' @keywords internal

estimate_coef <- function(variable, given,

                          lvl_var, lvl_given,

                          coef,

                          mmat,

                          vcov,

                          conf_level = 0.95) {

    }

  )

    }

  )

  })

  })

  )

}

#' `tryCatch` around `car::Anova`

#'

#' Captures warnings when executing [car::Anova].

#'

#' @inheritParams car::Anova

#'

#' @return A list with item `aov` for the result of the model and `error_text` for the captured warnings.

#'

#' @examples

#' # `car::Anova` on cox regression model including strata and expected

#' # a likelihood ratio test triggers a warning as only `Wald` method is

#' # accepted.

#'

#' library(survival)

#'

#' mod <- coxph(

#'   formula = Surv(time = futime, event = fustat) ~ factor(rx) + strata(ecog.ps),

#'   data = ovarian

#' )

#'

#' @keywords internal

try_car_anova <- function(mod,

                          test.statistic) { # nolint

          ),

        )

      },

        # If a warning is detected it is handled as "w".

        # A warning is sometimes expected, then, we want to restart

        # the execution while ignoring the warning.

      }

    ),

    }

  )

}

#' Fit the Cox Regression Model and `Anova`

#'

#' The functions allows to derive from the [survival::coxph()] results the effect p.values using [car::Anova()].

#' This last package introduces more flexibility to get the effect p.values.

#'

#' @inheritParams t_coxreg

#'

#' @return A list with items `mod` (results of [survival::coxph()]), `msum` (result of `summary`) and

#'   `aov` (result of [car::Anova()]).

#'

#' @noRd

fit_n_aov <- function(formula,

                      data = data,

                      conf_level = conf_level,

                      pval_method = c("wald", "likelihood"),

                      ...) {

    # We expect some warnings due to coxph which fails strict programming.

  })

    )

  )

}

# argument_checks

check_formula <- function(formula) {

  }

}

check_covariate_formulas <- function(covariates) {

  }

}

name_covariate_names <- function(covariates) {

}

check_increments <- function(increments, covariates) {

            )

          )

        }

      }

    )

  }

}

#' Multivariate Cox Model - Summarized Results

#'

#' Analyses based on multivariate Cox model are usually not performed for the Controlled Substance Reporting or

#' regulatory documents but serve exploratory purposes only (e.g., for publication). In practice, the model usually

#' includes only the main effects (without interaction terms). It produces the hazard ratio estimates for each of the

#' covariates included in the model.

#' The analysis follows the same principles (e.g., stratified vs. unstratified analysis and tie handling) as the

#' usual Cox model analysis. Since there is usually no pre-specified hypothesis testing for such analysis,

#' the p.values need to be interpreted with caution. (**Statistical Analysis of Clinical Trials Data with R**,

#' `NEST's bookdown`)

#'

#' @param formula (`formula`)\cr A formula corresponding to the investigated [survival::Surv()] survival model

#'   including covariates.

#' @param data (`data.frame`)\cr A data frame which includes the variable in formula and covariates.

#' @param conf_level (`proportion`)\cr The confidence level for the hazard ratio interval estimations. Default is 0.95.

#' @param pval_method (`character`)\cr The method used for the estimation of p-values, should be one of

#'   `"wald"` (default) or `"likelihood"`.

#' @param ... Optional parameters passed to [survival::coxph()]. Can include `ties`, a character string specifying the

#'   method for tie handling, one of `exact` (default), `efron`, `breslow`.

#'

#' @return A `list` with elements `mod`, `msum`, `aov`, and `coef_inter`.

#'

#' @details The output is limited to single effect terms. Work in ongoing for estimation of interaction terms

#'   but is out of scope as defined by the  Global Data Standards Repository

#'   (**`GDS_Standard_TLG_Specs_Tables_2.doc`**).

#'

#' @seealso [estimate_coef()].

#'

#' @examples

#' library(dplyr)

#'

#' adtte <- tern_ex_adtte

#' adtte_f <- subset(adtte, PARAMCD == "OS") # _f: filtered

#' adtte_f <- filter(

#'   adtte_f,

#'   PARAMCD == "OS" &

#'     SEX %in% c("F", "M") &

#'     RACE %in% c("ASIAN", "BLACK OR AFRICAN AMERICAN", "WHITE")

#' )

#' adtte_f$SEX <- droplevels(adtte_f$SEX)

#' adtte_f$RACE <- droplevels(adtte_f$RACE)

#'

#' @keywords internal

s_cox_multivariate <- function(formula, data,

                               conf_level = 0.95,

                               pval_method = c("wald", "likelihood"),

                               ...) {

      }

    }

  )

  # Results directly exported from environment(fit_n_aov) to environment(s_function_draft)

    ...

  )

      )

    }

      }

    )

  }

}

#' Confidence Interval for Mean

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Convenient function for calculating the mean confidence interval. It calculates the arithmetic as well as the

#' geometric mean. It can be used as a `ggplot` helper function for plotting.

#'

#' @inheritParams argument_convention

#' @param n_min (`number`)\cr a minimum number of non-missing `x` to estimate the confidence interval for mean.

#' @param gg_helper (`logical`)\cr `TRUE` when output should be aligned for the use with `ggplot`.

#' @param geom_mean (`logical`)\cr `TRUE` when the geometric mean should be calculated.

#'

#' @return A named `vector` of values `mean_ci_lwr` and `mean_ci_upr`.

#'

#' @examples

#' stat_mean_ci(sample(10), gg_helper = FALSE)

#'

#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(cyl, mpg)) +

#'   ggplot2::geom_point()

#'

#' p + ggplot2::stat_summary(

#'   fun.data = stat_mean_ci,

#'   geom = "errorbar"

#' )

#'

#' p + ggplot2::stat_summary(

#'   fun.data = stat_mean_ci,

#'   fun.args = list(conf_level = 0.5),

#'   geom = "errorbar"

#' )

#'

#' p + ggplot2::stat_summary(

#'   fun.data = stat_mean_ci,

#'   fun.args = list(conf_level = 0.5, geom_mean = TRUE),

#'   geom = "errorbar"

#' )

#'

#' @export

stat_mean_ci <- function(x,

                         conf_level = 0.95,

                         na.rm = TRUE, # nolint

                         n_min = 2,

                         gg_helper = TRUE,

                         geom_mean = FALSE) {

  }

  } else {

    } else {

    }

  }

  } else {

    }

  }

  }

}

#' Confidence Interval for Median

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Convenient function for calculating the median confidence interval. It can be used as a `ggplot` helper

#' function for plotting.

#'

#' @inheritParams argument_convention

#' @param gg_helper (`logical`)\cr `TRUE` when output should be aligned for the use with `ggplot`.

#'

#' @details The function was adapted from `DescTools/versions/0.99.35/source`

#'

#' @return A named `vector` of values `median_ci_lwr` and `median_ci_upr`.

#'

#' @examples

#' stat_median_ci(sample(10), gg_helper = FALSE)

#'

#' p <- ggplot2::ggplot(mtcars, ggplot2::aes(cyl, mpg)) +

#'   ggplot2::geom_point()

#' p + ggplot2::stat_summary(

#'   fun.data = stat_median_ci,

#'   geom = "errorbar"

#' )

#'

#' @export

stat_median_ci <- function(x,

                           conf_level = 0.95,

                           na.rm = TRUE, # nolint

                           gg_helper = TRUE) {

  }

  # k == 0 - for small samples (e.g. n <= 5) ci can be outside the observed range

  } else {

  }

  }

}

#' p-Value of the Mean

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Convenient function for calculating the two-sided p-value of the mean.

#'

#' @inheritParams argument_convention

#' @param n_min (`numeric`)\cr a minimum number of non-missing `x` to estimate the p-value of the mean.

#' @param test_mean (`numeric`)\cr mean value to test under the null hypothesis.

#'

#' @return A p-value.

#'

#' @examples

#' stat_mean_pval(sample(10))

#'

#' stat_mean_pval(rnorm(10), test_mean = 0.5)

#'

#' @export

stat_mean_pval <- function(x,

                           na.rm = TRUE, # nolint

                           n_min = 2,

                           test_mean = 0) {

  }

  } else {

  }

}

#' Proportion Difference and Confidence Interval

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Function for calculating the proportion (or risk) difference and confidence interval between arm

#' X (reference group) and arm Y. Risk difference is calculated by subtracting cumulative incidence

#' in arm Y from cumulative incidence in arm X.

#'

#' @inheritParams argument_convention

#' @param x (`list` of `integer`)\cr list of number of occurrences in arm X (reference group).

#' @param y (`list` of `integer`)\cr list of number of occurrences in arm Y. Must be of equal length to `x`.

#' @param N_x (`numeric`)\cr total number of records in arm X.

#' @param N_y (`numeric`)\cr total number of records in arm Y.

#' @param list_names (`character`)\cr names of each variable/level corresponding to pair of proportions in

#'   `x` and `y`. Must be of equal length to `x` and `y`.

#' @param pct (`flag`)\cr whether output should be returned as percentages. Defaults to `TRUE`.

#'

#' @return List of proportion differences and CIs corresponding to each pair of number of occurrences in `x` and

#'   `y`. Each list element consists of 3 statistics: proportion difference, CI lower bound, and CI upper bound.

#'

#' @seealso Split function [add_riskdiff()] which, when used as `split_fun` within [rtables::split_cols_by()]

#'   with `riskdiff` argument is set to `TRUE` in subsequent analyze functions, adds a column containing

#'   proportion (risk) difference to an `rtables` layout.

#'

#' @examples

#' stat_propdiff_ci(

#'   x = list(0.375), y = list(0.01), N_x = 5, N_y = 5, list_names = "x", conf_level = 0.9

#' )

#'

#' stat_propdiff_ci(

#'   x = list(0.5, 0.75, 1), y = list(0.25, 0.05, 0.5), N_x = 10, N_y = 20, pct = FALSE

#' )

#'

#' @export

stat_propdiff_ci <- function(x,

                             y,

                             N_x, # nolint

                             N_y, # nolint

                             list_names = NULL,

                             conf_level = 0.95,

                             pct = TRUE) {

  })

}

#' Helper Function for Tabulation of a Single Biomarker Result

#'

#' @description `r lifecycle::badge("stable")`

#'

#' Please see [h_tab_surv_one_biomarker()] and [h_tab_rsp_one_biomarker()], which use this function for examples.

#' This function is a wrapper for [rtables::summarize_row_groups()].

#'

#' @inheritParams argument_convention

#' @param df (`data.frame`)\cr results for a single biomarker.

#' @param afuns (named `list` of `function`)\cr analysis functions.

#' @param colvars (`list` with `vars` and `labels`)\cr variables to tabulate and their labels.

#'

#' @return An `rtables` table object with statistics in columns.

#'

#' @export

h_tab_one_biomarker <- function(df,

                                afuns,

                                colvars,

                                na_str = default_na_str(),

                                .indent_mods = 0L,

                                ...) {

  # Row split by row type - only keep the content rows here.

  )

  # Summarize rows with all patients.

  )

  # Split cols by the multiple variables to populate into columns.

  )

  # If there is any subgroup variables, we extend the layout accordingly.

    # Now only continue with the subgroup rows.

    )

    # Split by the subgroup variable.

    )

    # Then analyze colvars for each subgroup.

    )

  }

}

#' Create a forest plot from an `rtable`

#'

#' Given a [rtables::rtable()] object with at least one column with a single value and one column with 2

#' values, converts table to a [ggplot2::ggplot()] object and generates an accompanying forest plot. The

#' table and forest plot are printed side-by-side.

#'

#' @description `r lifecycle::badge("stable")`

#'

#' @inheritParams rtable2gg

#' @inheritParams argument_convention

#' @param tbl (`rtable`)\cr table with at least one column with a single value and one column with 2 values.

#' @param col_x (`integer`)\cr column index with estimator. By default tries to get this from

#'   `tbl` attribute `col_x`, otherwise needs to be manually specified. If `NULL`, points will be excluded

#'   from forest plot.

#' @param col_ci (`integer`)\cr column index with confidence intervals. By default tries to get this from

#'   `tbl` attribute `col_ci`, otherwise needs to be manually specified. If `NULL`, lines will be excluded

#'   from forest plot.

#' @param vline (`numeric`)\cr x coordinate for vertical line, if `NULL` then the line is omitted.

#' @param forest_header (`character`, length 2)\cr text displayed to the left and right of `vline`, respectively.

#'   If `vline = NULL` then `forest_header` is not printed. By default tries to get this from `tbl` attribute

#'   `forest_header`. If `NULL`, defaults will be extracted from the table if possible, and set to

#'   `"Comparison\nBetter"` and `"Treatment\nBetter"` if not.

#' @param xlim (`numeric`)\cr limits for x axis.

#' @param logx (`flag`)\cr show the x-values on logarithm scale.

#' @param x_at (`numeric`)\cr x-tick locations, if `NULL`, `x_at` is set to `vline` and both `xlim` values.

#' @param width_row_names `r lifecycle::badge("deprecated")` Please use the `lbl_col_padding` argument instead.

#' @param width_columns (`vector` of `numeric`)\cr a vector of column widths. Each element's position in

#'   `colwidths` corresponds to the column of `tbl` in the same position. If `NULL`, column widths are calculated

#'   according to maximum number of characters per column.

#' @param width_forest `r lifecycle::badge("deprecated")` Please use the `rel_width_forest` argument instead.

#' @param rel_width_forest (`proportion`)\cr proportion of total width to allocate to the forest plot. Relative

#'   width of table is then `1 - rel_width_forest`. If `as_list = TRUE`, this parameter is ignored.

#' @param font_size (`numeric`)\cr font size.

#' @param col_symbol_size (`integer`)\cr column index from `tbl` containing data to be used

#'   to determine relative size for estimator plot symbol. Typically, the symbol size is proportional

#'   to the sample size used to calculate the estimator. If `NULL`, the same symbol size is used for all subgroups.

#'   By default tries to get this from `tbl` attribute `col_symbol_size`, otherwise needs to be manually specified.

#' @param col (`character`)\cr color(s).

#' @param ggtheme (`theme`)\cr a graphical theme as provided by `ggplot2` to control styling of the plot.

#' @param as_list (`flag`)\cr whether the two `ggplot` objects should be returned as a list. If `TRUE`, a named list

#'   with two elements, `table` and `plot`, will be returned. If `FALSE` (default) the table and forest plot are

#'   printed side-by-side via [cowplot::plot_grid()].

#' @param gp `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#' @param draw `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#' @param newpage `r lifecycle::badge("deprecated")` `g_forest` is now generated as a `ggplot` object. This argument

#'   is no longer used.

#'

#' @return `ggplot` forest plot and table.

#'

#' @examples

#' library(dplyr)

#' library(forcats)

#' library(nestcolor)

#'

#' adrs <- tern_ex_adrs

#' n_records <- 20

#' adrs_labels <- formatters::var_labels(adrs, fill = TRUE)

#' adrs <- adrs %>%

#'   filter(PARAMCD == "BESRSPI") %>%

#'   filter(ARM %in% c("A: Drug X", "B: Placebo")) %>%

#'   slice(seq_len(n_records)) %>%

#'   droplevels() %>%

#'   mutate(

#'     # Reorder levels of factor to make the placebo group the reference arm.

#'     ARM = fct_relevel(ARM, "B: Placebo"),

#'     rsp = AVALC == "CR"

#'   )

#' formatters::var_labels(adrs) <- c(adrs_labels, "Response")

#' df <- extract_rsp_subgroups(

#'   variables = list(rsp = "rsp", arm = "ARM", subgroups = c("SEX", "STRATA2")),

#'   data = adrs

#' )

#' # Full commonly used response table.

#'

#' tbl <- basic_table() %>%

#'   tabulate_rsp_subgroups(df)

#' g_forest(tbl)